home *** CD-ROM | disk | FTP | other *** search
/ EuroCD 3 / EuroCD 3.iso / Programming / SecalDemo / Projects / Examples / BallDemo.scl < prev    next >
Text File  |  1998-06-24  |  9KB  |  363 lines
  1. /******************************************************************************\
  2. **  Ball demo for Secal                                                       **
  3. **  Requires Kickstart 3                                                      **
  4. **  Try to change "BALLNUM"                                                   **
  5. \******************************************************************************/
  6.  
  7.  
  8. go main;
  9.  
  10.  
  11. #-------------------------------------------------------------------------------
  12.  
  13.  
  14. def BALLNUM=49;                            # NUMBER OF BALLS
  15. def CHANGETIME=300;                    # TIME FOR EACH PATTERN
  16.  
  17.  
  18. #-------------------------------------------------------------------------------
  19.  
  20.  
  21. include "inc/libcalls/exec.inc";
  22. include "inc/libcalls/intuition.inc";
  23. include "inc/libcalls/graphics.inc";
  24. include "inc/lvos/graphics.inc";
  25.  
  26. include "inc/hardware/custom.inc";
  27. include "inc/utility/tagitem.inc";
  28. include "inc/intuition/screens.inc";
  29. include "inc/graphics/rastport.inc";
  30. include "inc/graphics/gfx.inc";
  31.  
  32.  
  33. def SysBase=[4.w].ul;
  34.  
  35.  
  36. /******************************************************************************\
  37. ************                      M A I N                           ************
  38. \******************************************************************************/
  39.  
  40.  
  41. obj GfxBase,IntuitionBase:ulong;
  42.  
  43. obj myscr:ulong;
  44. obj scrbuf0,scrbuf1:ulong;
  45. obj scrwidth,xcenter,ycenter:word;
  46.  
  47.  
  48. #-------------------------------------------------------------------------------
  49.  
  50.  
  51. main:
  52. push a5;
  53.  
  54. a5:=$dff000;                                # GLOBAL CUSTOM BASE REGISTER
  55.  
  56. call sysinit;
  57. if d0 then
  58.     call ballsinit;
  59.  
  60.     repeat
  61.         call ballsframe;                # PROCESS EACH FRAME
  62.     until [$dff016] and $400=0;        # DIRTY CHECK FOR RIGHT MOUSE BUTTON
  63.  
  64.     call sysdone;
  65. ;
  66.  
  67. d0.l:=0;
  68.  
  69. pop a5;
  70. rts;                                                            # MAIN
  71.  
  72.  
  73. #-------------------------------------------------------------------------------
  74.  
  75.  
  76. #                                                                    D0=SUCCESS
  77.  
  78. sysinit:
  79. OpenLibrary("graphics.library",39); GfxBase:=d0;
  80. if GfxBase then
  81.     OpenLibrary("intuition.library",37); IntuitionBase:=d0;
  82.     if IntuitionBase then
  83.                                                         # LIBRARIES
  84.  
  85.         OpenScreenTagList(0,@scrtags); myscr:=d0;
  86.         if myscr then
  87.             a0:=myscr; GetBitMapAttr(Screen(a0).RastPort.BitMap,BMA_FLAGS);
  88.             if d0.l and BMF_INTERLEAVED then
  89.  
  90.                 AllocScreenBuffer(myscr,0,SB_SCREEN_BITMAP); scrbuf0:=d0;
  91.                 if scrbuf0 then
  92.                     AllocScreenBuffer(myscr,0,SB_COPY_BITMAP); scrbuf1:=d0;
  93.                     if scrbuf1 then
  94.                                                         # OS DOUBLE BUFFERING
  95.  
  96.                         a0:=myscr;
  97.                         xcenter:=Screen(a0).Width/2;
  98.                         d0:=Screen(a0).Height-(Screen(a0).BarHeight+1);
  99.                         ycenter:=d0/2+(Screen(a0).BarHeight+1);        # 0,0 OFFSET
  100.                         a0:=Screen(a0).RastPort.BitMap;
  101.                         scrwidth:=BitMap(a0).BytesPerRow;            # SCREEN WIDTH
  102.  
  103.                         d0:=-1; go end_sysinit;    # INIT SUCCESSFULL
  104.                     ;
  105.  
  106.                                                         # OTHERWISE FAILED
  107.                     FreeScreenBuffer(myscr,scrbuf0);
  108.                 ;
  109.  
  110.             ;
  111.             CloseScreen(myscr);
  112.         ;
  113.         CloseLibrary(IntuitionBase);
  114.     ;
  115.     CloseLibrary(GfxBase);
  116. ;
  117.  
  118. d0:=0;
  119.  
  120. end_sysinit:
  121. rts;                                                            # SYSINIT
  122.  
  123.  
  124.  
  125. scrtags:
  126. dc.l SA_Depth,4;
  127. dc.l SA_Interleaved,-1;
  128. dc.l SA_Title,"Secal Ball demo";
  129. dc.l SA_Colors,@scrcolors;
  130. dc.l SA_Pens,@scrpens;
  131. dc.l TAG_DONE;                            # TAGS FOR OUR SCREEN
  132.  
  133. scrcolors:
  134. dc 0,$0,$0,$0,  1,$e,$f,$e,  2,$3,$7,$e,  3,$2,$6,$c;
  135. dc 4,$1,$5,$a,  5,$0,$4,$8,  6,$0,$3,$6,  7,$0,$2,$4;
  136. dc 8,$0,$1,$2,  9,$e,$7,$3,  10,$c,$6,$2, 11,$a,$5,$1;
  137. dc 12,$8,$4,$0, 13,$6,$3,$0, 14,$4,$2,$0, 15,$2,$1,$0;
  138. dc -1;                                            # COLORS OF THE SCREEN
  139.  
  140. scrpens:
  141. dc -1;                                            # TO MAKE IT "NEW LOOK"
  142.  
  143.  
  144.  
  145.  
  146.  
  147. sysdone:
  148. FreeScreenBuffer(myscr,scrbuf1);
  149. FreeScreenBuffer(myscr,scrbuf0);            # FREE BUFFERS
  150.  
  151. CloseScreen(myscr);                            # CLOSE SCREEN
  152.  
  153. CloseLibrary(GfxBase);
  154. CloseLibrary(IntuitionBase);                # CLOSE LIBS
  155. rts;                                                            # SYSDONE
  156.  
  157.  
  158. /******************************************************************************\
  159. ************                     B A L L S                          ************
  160. \******************************************************************************/
  161.  
  162.  
  163. obj bufcount:word;
  164. obj workbufptr:ulong;
  165. obj screenbitplanes:ulong;
  166.  
  167.  
  168. obj patchng:word;
  169. obj patptr:ulong;
  170.  
  171. obj x0,x1,y0,y1:word;
  172.  
  173. obj vx0,vx1,vy0,vy1:word;
  174. obj dx0,dx1,dy0,dy1:word;
  175.  
  176.  
  177. #*******************************************************************************
  178.  
  179.  
  180. ballsinit:
  181. [@workbuf0].l:=0; [@workbuf1].l:=0;
  182. workbufptr:=@workbuf0;            # BUFFER INIT
  183.  
  184. patchng:=0; patptr:=@patsource;        # PATTERN INIT
  185. rts;                                                            # BALLSINIT
  186.  
  187.  
  188. #-------------------------------------------------------------------------------
  189.  
  190.  
  191. ballsframe:
  192. call changescreen;                        # SWAP SCREEN BUFFERS
  193.  
  194. if patchng=0 then
  195.     a0:=patptr;
  196.     vx0:=[a0+]; vx1:=[a0+]; vy0:=[a0+]; vy1:=[a0+];
  197.     dx0:=[a0+]; dx1:=[a0+]; dy0:=[a0+]; dy1:=[a0+];
  198.     if a0=@end_patsource then a0:=@patsource;;
  199.     patptr:=a0;
  200.  
  201.     x0:=0; x1:=0; y0:=0; y1:=0;
  202.     patchng:=CHANGETIME;                # GET NEXT PATTERN
  203. else
  204.     patchng:=patchng-1;
  205. ;                                                            # DECREMENT COUNTER
  206.  
  207. OwnBlitter;
  208. call clearballs;
  209. call drawcalcballs;
  210. WaitBlit;
  211. DisownBlitter;                                # DO BALLS
  212.  
  213. x0:=x0+vx0; x1:=x1+vx1;
  214. y0:=y0+vy0; y1:=y1+vy1;
  215. rts;                                                            # BALLSFRAME
  216.  
  217.  
  218.  
  219. patsource:
  220. dc 11,8,36,20,80,32,200,128;
  221. dc $fff0,$10,$fff8,$ffec,$fe10,$208,$410,$414;
  222. dc $8,$10,$8,0,$3e0,$3e8,$3e8,$3e0;
  223. dc $10,$8,$8,$10,$208,$fc10,$fc10,$208;
  224. dc $8,$10,$8,$10,$d0,$d0,$c8,$c8;
  225. dc $4,$10,$c,$18,$1fc,$214,$fffc,$414;
  226. dc $8,$10,$8,$10,$ff34,$8,0,$d4;
  227. dc $8,$8,$8,$8,$238,$fc38,$38,$fe38;
  228. dc $fff1,$10,$f,$fff4,$fe08,$20a,$3ff,$408;
  229. dc $8,$8,$8,$8,$3e0,$fc00,$3e0,0;
  230. dc $8,$10,$8,$10,$d0,$c8,$c8,$d0;
  231. dc $8,$8,$fff8,$8,$3f0,$10,$3f0,$fff0;
  232. end_patsource:                                # LISSAJOUS PATTERNS
  233.  
  234.  
  235. #-------------------------------------------------------------------------------
  236.  
  237.  
  238. changescreen:
  239. WaitBlit;
  240.  
  241. if bufcount=0 then
  242.     ChangeScreenBuffer(myscr,scrbuf0);
  243. else
  244.     ChangeScreenBuffer(myscr,scrbuf1);
  245. ;                                                            # CHANGE SCR BUFS
  246.  
  247. WaitTOF;                                            # WAIT NEXT FRAME
  248.  
  249. bufcount:=bufcount xor 1;            # FLIP PAGE ID
  250.  
  251. if bufcount=0 then
  252.     workbufptr:=@workbuf0;
  253.  
  254.     a0:=scrbuf0; a0:=ScreenBuffer(a0).sb_BitMap;
  255.     a0:=@BitMap(a0).Planes; screenbitplanes:=[a0];
  256. else
  257.     workbufptr:=@workbuf1;
  258.  
  259.     a0:=scrbuf1; a0:=ScreenBuffer(a0).sb_BitMap;
  260.     a0:=@BitMap(a0).Planes; screenbitplanes:=[a0];
  261. ;                                                            # GET WORK BUF
  262. rts;                                                            # CHANGESCREEN
  263.  
  264.  
  265. #-------------------------------------------------------------------------------
  266.  
  267.  
  268. clearballs:
  269. push d2\a2\a6;
  270.  
  271. a2:=workbufptr; a6:=GfxBase;            # PRELOAD REGS
  272.  
  273. if [a2].l then
  274.     WaitBlit;
  275.     Custom(a5).bltcon0:=$100; Custom(a5).bltcon1:=0;
  276.     Custom(a5).bltdmod:=scrwidth lsr 2-4;        # PRELOAD BLT REGS
  277.  
  278.     for d2:=BALLNUM-1 downto 0 do
  279.         call a6+LVOWaitBlit;        # DIRECT CALL WITH LVO!
  280.         Custom(a5).bltdpt:=[a2+];            # POINTER FROM BUF
  281.         Custom(a5).bltsize:=(16*4) lsl 6 or 2;
  282.     ;                                                        # CLEAR EVERY BALL
  283. ;
  284.  
  285. pop d2\a2\a6;
  286. rts;                                                            # CLEARBALLS
  287.  
  288.  
  289.  
  290.  
  291.  
  292. obj dcb_counter:word;
  293.  
  294.  
  295.  
  296. drawcalcballs:
  297. push d2\d3\d4\d5\a2\a3\a4\a6;
  298.  
  299. a2:=workbufptr;
  300. d2:=x0; d3:=x1; d4:=y0; d5:=y1;
  301. a3:=@sincostable; a4:=a3+$800; a6:=GfxBase;    # PRELOAD REGS
  302.  
  303. WaitBlit;
  304. Custom(a5).bltafwm:=-1; Custom(a5).bltalwm:=0;
  305. Custom(a5).bltamod:=-2; Custom(a5).bltbmod:=-2;
  306. Custom(a5).bltcmod:=scrwidth lsr 2-4;
  307. Custom(a5).bltdmod:=scrwidth lsr 2-4;        # PRELOAD BLT REGS
  308.  
  309. for dcb_counter:=BALLNUM-1 downto 0 do
  310.     d0:=(d4 and $fff) << 1; d1:=[a4+d0.w];
  311.     d0:=(d5 and $fff) << 1; d1:=d1+[a4+d0.w];
  312.     d1:=d1 asr 3+ycenter;
  313.     a0:=d1.w*scrwidth;                    # LISSAJOUS CALCS
  314.  
  315.     d0:=(d2 and $fff) << 1; d1:=[a3+d0.w];
  316.     d0:=(d3 and $fff) << 1; d1:=d1+[a3+d0.w];
  317.     d1:=d1 asr 2+xcenter;
  318.     a0:=a0+(d1.w lsr 3) and -2;            # LISSAJOUS CALCS
  319.  
  320.     d1:=d1 lsl 12;
  321.     a0:=screenbitplanes+a0; [a2+].l:=a0;        # STORE PLANEPTR FOR CLEAR
  322.  
  323.     call a6+LVOWaitBlit;            # DOCUMENTED TO PRESERVE ALL REGS!
  324.  
  325.     Custom(a5).bltcon1:=d1;
  326.     d1:=d1 or $fca; Custom(a5).bltcon0:=d1;
  327.     Custom(a5).bltcpt:=a0; Custom(a5).bltdpt:=a0;
  328.     Custom(a5).bltapt:=@ballmaskdata;
  329.  
  330.     if dcb_counter and 1 then Custom(a5).bltbpt:=@balldata0;
  331.     else Custom(a5).bltbpt:=@balldata1;;
  332.     Custom(a5).bltsize:=(16*4) lsl 6 or 2;    # START BLIT
  333.  
  334.     d2:=d2+dx0; d3:=d3+dx1;
  335.     d4:=d4+dy0; d5:=d5+dy1;
  336. ;                                                            # PROCESS EVERY BALL
  337.  
  338. pop d2\d3\d4\d5\a2\a3\a4\a6;
  339. rts;                                                            # DRAWCALCBALLS
  340.  
  341.  
  342. #*******************************************************************************
  343.  
  344.  
  345. sincostable:                        incbin "data/sincos.dat";
  346.                                                 # 1.25 SINE WAVE, 4096+1024 WORDS, 4096=1 WAVE (2*PI)
  347.  
  348. data_c;
  349.  
  350. ballmaskdata:                        incbin "data/ball_a_mask";
  351. balldata0:                            incbin "data/ball_a_0";
  352. balldata1:                            incbin "data/ball_a_1";
  353.  
  354.  
  355. bss;
  356.  
  357. workbuf0:                                ds.l BALLNUM;
  358. workbuf1:                                ds.l BALLNUM;        # BUFFER FOR POINTERS
  359.  
  360.  
  361. #*******************************************************************************
  362.  
  363.